perm filename COORDS.F4[DRW,LCS] blob sn#493201 filedate 1980-01-11 generic text, type T, neo UTF8
C THIS PROGRAM EXTRACTS THE X-Y COORDINATES FROM 'DRAW' LIBRARY FILES.
C  IT MAY BE THAT THE NAME EXTENSIONS MUST BE CHANGED FOR THIS TO WORK.
	COMMON J(512),K(3),JJ(21),M
	TYPE 1000
1000	FORMAT(' FILE NAME (NO EXT.) -- '$)
1001	FORMAT(A5)
	ACCEPT 1001,NAME
	TYPE 1
1	FORMAT(' TO DSK? TYPE Y OR N'/)
	ACCEPT 11,L
	M=5
	IF(L.NE.'Y')GO TO 3
	M=1
	TYPE 2
2	FORMAT(' WRITING FILE FOR01.DAT'/)
3	CALL GETFILE(NAME)
	CALL FASTIN(JJ,21 )
11	FORMAT(A1)
10	FORMAT(10I8,/I4,/2X,10(3XA5))
	WRITE(M,10),JJ
	N=JJ(11)
C WD CNT
	CALL FASTIN(J,N)
	CALL RDRAW(1,J(1),J)
	END

	SUBROUTINE RDRAW(I,JA,IJ)
	COMMON J(512),K(3),JJ(21),M
	DIMENSION IJ(1)
	I=1
  	WRITE(M,4),JJ(1)
	DO 3 KK=1,10
	KA=0
	JA=JJ(KK)
	DO 2 L=I,JA
	CALL UNPACK(L,IA,IB,J)
	KA=KA+1
  	IF(L.NE.JA)GO TO 2
	KA=0
	WRITE(M,4),JJ(KK+11)
2	WRITE(M,10),KA,IA,IB,J(L)
3	I=JA+1
4	FORMAT(/1XA5)
10	FORMAT(4I)
	END
	SUBROUTINE UNPACK(K,M,N,I)
	COMMON/LL/L
C  L IS FOR VIS. OR INVIS. LINES.
	DIMENSION I(1)
	N=I(K)
	L=0
	IF(N.LT.100000000)GO TO 2
	L=(N/100000000)*100000000
	N=N-L
2	M=N/10000
	N=N-M*10000
	IF(M.GT.1000)M=1000-M
	IF(N.GT.1000)N=1000-N
	END